perm filename T3.FOR[ZZZ,LCS] blob
sn#439863 filedate 1979-05-08 generic text, type T, neo UTF8
SUBROUTINE MSCAN
INTEGER*4 INST,INAM
DIMENSION TONES(21)
COMMON LL /P/W(1)
CIN COMMON /TR/I(80),RX(100),JX(100),LX(12),INST(27,4),K
CC COMMON /I/I(1) /TR/RX(80),JX(80),LX(12),K
COMMON /ROUT/I(200),RX(80),JX(80) /TR/LX(12),K
1,INSNUM(27),P(30),NPAR(27),JSEM,IPRNT,IPP
1,SRATE,RNCHN,RMAG,INUM,INS,MM,M,N,JJ,X,Y,IK
1,ENDX,J /KNAM/IPLAY,JFLNM /INST/INST(1)
COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
COMMON /SBFILN/SBFILN /AR/IOP /IGEN/IGEN /JP/JPRNT
INTEGER RPR
EQUIVALENCE (LESS,LX(9)),(W1,W(1)),(W2,W(2)),(W3,W(3)),(W4,W(4)),
1 (RX2,RX(3)),(P2,P(2)),(RX3,RX(5)),(I3,I(3))
1 ,(ISEMI,LX(2)),(IAST,LX(3)),(LEQUAL,LX(8))
1,(LPR,LX(11)),(RPR,LX(12)),(ICOM,LX(10)),(LAROW,LX(7))
DATA TONES/246.945,261.62,277.18,277.8,293.66,311.13,311.13,
1 329.63,349.23,329.63,349.23,369.99,369.99,
1 391.99,415.31,415.31,440.0,466.16,466.16,493.89,523.24/
C**** CODE NUMS. 1=OUT 2=OSC 3=AD2 4=RAN 5=END 6=STR 7=AD3 8=AD4 9=MLT
C**** 10=DIV 11=RAH 12=END 13=REV 14=OPT 15=NOS 16=SUB 17=INP 18=COS
C**** B1=101 ETC. P1=201 ETC. F1=301 ETC. FREQ-PARAMS=600S, DURS=700S.
C**** 400=PLAY 401=FINI 402=SRATE 403=NCHNS 404=PRINT 405=CHA
C**** 407=SRT 409=GEN 410=SEG 411=SIN 412=INS 413=UNIT GEN.
C**** 500=CF 501=C 502=CS 503=DF 504=D 505=DS 506=EF 507=E 508=ES 509=FF
C**** 510=F 511=FS 512=GF 513=G 514=GS 515=AF 516=A 517=AS 518=BF 519=B 520=BS
JSEM=0
C IS THIS NEEDED HERE?
C JSEM=0 FOR 'PLAY' OR ASSIGNMENT ( P3←440;, A=444; ETC.)
LL=1
INS=-1
34 J=J+2
2324 FORMAT(1X20F10.3/)
2325 FORMAT(1X20I/)
2323 FORMAT(1X20A1/)
IXJ=JX(J)
IPP=0
C!FOR 'P3←333;' ETC.
IOP=-1
9 IF(J.GE.MM)GO TO 1001
IF(RX(J+1).EQ.-9999.0)GO TO 11
C!*** SKIP IF NUMBER
IF(IGEN.GT.0)GO TO 450
C IGEN=2=INSIDE AN INST. DEFINITION.
C!***** LOOK FOR SPECIAL WORDS
IF(IXJ/400.NE.1)GO TO 402
K=IXJ-399
C PRINT
GO TO (13,13,304,303,302,303,4,505,505,422,422,422,32)K
C (PLAY) FINI SRAT NCHN CHA SRT GEN SEG SIN INS
32 W1=2
IXJ=13
JX(J)=13
IGEN=2
GO TO 424
505 JK=4
C !**** FOR SRT
IF(K.NE.4)JK=2
JK=J+JK
GO TO 304
450 K=IXJ
C** HERE FOR INST DEFINITIONS.
C 14='OPT' USER-ADDED UNIT GENERATOR.
IF(K.EQ.12)GO TO 412
IF(K.GT.0)GO TO 425
GO TO 1001
504 FORMAT(' UNKNOWN SYMBOL ',A4)
412 LL=3
IGEN=1
C!*** =1 IS FLAG TO CHANGE IT TO -1
J=MM
INS=-1
GO TO 10
422 W1=3
C!***** GEN
IF(K.GT.10)W1=K-4
C SEG=11, SIN=12 AT THIS POINT.
IGEN=0
424 INS=-1
LL=2
GO TO 36
425 W3=K+100
436 LL=4
GO TO 36
4 JL=LL
JOP=IOP
J=J+2
IF(JX(J).NE.LPR)CALL ERR(2)
IOP=-1
GO TO 36
C!**FIND NUM UP TO THE COMMA
302 LL=1
IPRNT=-1
C!***** FOR 'PRINT' FEATURE
GO TO 36
304 SRATE=RX(J+4)
J=J+6
RMAG=512./SRATE
W3=4
W4=SRATE
351 W1=11
W2=0
IGEN=0
LL=5
C JSEM=-1 = SEND DATA BACK TO MUS5,PASS3.
10 JSEM=-1
RETURN
303 RNCHN=RX(J+4)
C!**** FOR NCHNS←N; OR CHA ← N;
J=J+6
352 W3=8
C!*** FOR NCHNS
W4=RNCHN-1
GO TO 351
36 J=J+2
IF(J.GT.MM)GO TO 1001
C!****** 50 = DONE
IF(IPLAY.LT.0)P(LL-3)=W(LL-1)
C **** LL HAD BETTER ALWAYS BE >3 HERE.
C FILL UP PARAM LIST WITH DATA FOLLOWING INST NAME.
1002 IXJ=JX(J)
IF(IXJ.NE.ISEMI)GO TO 1
IPLAY=0
1000 IF(IPP.EQ.0)GO TO 10
P(IPP)=W1
LL=1
IPP=0
IF(J.LT.MM)GO TO 34
INS=-1
C!*** I HOPE THIS IS THE RIGHT PLACE FOR THIS.
CX PAUSE 'LABEL 1001'
1001 JSEM=0
RETURN
1 IF(RX(J+1).NE.-9999.0)GO TO 2
CX TYPE 2325,IOP
CX PAUSE 'LABEL 1'
11 IF(IOP.LT.0)GO TO 40
IF(IOP.NE.6)GO TO 12
RX(J)=-RX(J)
C!*** IOP=6 MEANS MINUS WITH COMMA IN FRONT
W(LL)=RX(J)
LL=LL+1
GO TO 14
12 CALL ARITH(RX(J),W,LL)
14 IOP=-1
C!*** RESET OPERATOR FLAG
GO TO 36
C!*** USE PARENTH'S FOR COMPOSITE EXPRESSIONS!!!!
40 W(LL)=RX(J)
38 LL=LL+1
IF(IOP.LT.0)GO TO 36
C IOP = NEG = NO OPERATOR BEFORE THIS ITEM.
LL=LL-1
380 CALL ARITH(W(LL),W,LL)
GO TO 14
C!**** READING CONTINUATION LINE.
402 IF(IXJ.GE.0)GO TO 33
C NEXT TRIES TO FIND INST. NAME.
C NA POINTS TO SPOT IN I ARRAY, M IS WDCNT.
CALL PACKER(INAM,I(-IXJ))
DO 233 IK=1,INUM
233 IF(INST(IK).EQ.INAM)GO TO 333
TYPE 504,INAM
GO TO 33
333 IPLAY=-1
C FLAG TO START FILLING PARAMS.
W2=INSNUM(IK)
C!**** W IS P ARRAY IN MUSIC5
LL=3
C!**** W2 AND W3 WILL BE EXCHANGED LATER
J=J+2
GO TO 1002
33 INS=2
C! NEXT IS SOMETHING OUTSIDE OF INST. AND PARAMS.
2 IF(IGEN.GT.0)GO TO 427
IF(IXJ.GT.520)GO TO 341
IF(IXJ.LT.500)GO TO 427
C NOW FOUND A NOTE
K=IXJ-499
W(LL)=TONES(K)
GO TO 38
C!***** FINDS NOTE IN SCALE
C!****** FIND A PARAM NUM.
427 IF(IXJ.GE.300)GO TO 307
IF(IXJ.LT.200)GO TO 344
K=IXJ-200
C NOW K HAS PARAM NUM.
IF(INS.LE.0)GO TO 340
JK=J+2
CCC IF(JX(JK).NE.LAROW)GO TO 340
IF(JX(JK).NE.LEQUAL)GO TO 340
IPP=K
LL=1
J=JK
GO TO 36
340 W(LL)=P(K)
C!***** FOUND Pn
IF(IPRNT.LT.0)GO TO 38
IF(IGEN.GT.0)W(LL)=K+2.
C!*** PARAM NUMS ARE 2 LESS THAN IN BOOK.
GO TO 38
C!**** P4 IS CHANGED TO 6
307 IF(IXJ.GE.400)GO TO 344
IF(IXJ/300.NE.1)GO TO 344
JL=IXJ-300
IF(IGEN.GT.0)JL=-JL-100
C!*** FOR Fn IN INST DEFINITION
W(LL)=JL
GO TO 38
344 IF(IGEN.LE.0)GO TO 341
C*** FOR B1, ETC. IN INST. DEFS.
IF(IXJ/100.NE.1)GO TO 341
W(LL)=100-IXJ
GO TO 38
341 DO 39 K=3,6
IF(LX(K).NE.IXJ)GO TO 39
IF(K.NE.3)GO TO 342
IF(JX(J+2).NE.IAST)GO TO 342
C NOW FOUND 'X**Y', =X TO THE POWER OF Y
K=7
J=J+2
342 IOP=K-2
C IOP NUMS ARE: 1=+ 2=- 3=* 4=/ 5=**
JK=JX(J-2)
IF(JK.EQ.ICOM)IOP=6
C!** COMMA DISABLES NEXT OPERATOR
IF(JK.EQ.LEQUAL)IOP=6
CCC IF(JK.EQ.LAROW)IOP=6
C!** ← DISABLES NEXT OPERATOR
IF(JK.EQ.LPR)IOP=6
C!** LFT PARENTH. DISABLES NEXT OPERATOR
GO TO 36
39 CONTINUE
CCC308 IF(IXJ.EQ.LAROW)GO TO 36
308 IF(IXJ.EQ.LEQUAL)GO TO 36
C!*** PASS LEFT ARROW
IF(IXJ.EQ.RPR)GO TO 500
IF(IXJ.EQ.LPR)GO TO 500
C LEFT AND RIGHT PARENTHESES
IF(IXJ.NE.402)GO TO 510
C 402=SRATE
W(LL)=SRATE
335 LL=LL+1
GO TO 36
C**** OR SHOULD NEXT BE 403???
510 IF(IXJ.NE.403)GO TO 511
C 403-'NCHNS'
W(LL)=RNCHN
GO TO 335
511 IF(IXJ.NE.ICOM)RETURN
C!***** UNKNOWN CHAR.
500 IF(IXJ.NE.LPR)GO TO 501
KOP=IOP
IOP=-1
JL=LL
C!**** SAVE VARIOUS POINTERS WHEN INSIDE PARENTHS.
GO TO 36
501 IF(IXJ.NE.RPR)GO TO 502
C!*** GET BACK STUFF
IOP=KOP
IF(IOP.LT.0)GO TO 36
LL=JL
GO TO 380
C!GO DO ARITHMETIC
502 IF(IPRNT.LT.0)GO TO 36
C!**** FOUND COMMA IN PRINT STATEMENT.
5 IF(JX(J-2).NE.ICOM)GO TO 132
433 W(LL)=P(LL-2)
C!** ONLY CARES ABOUT 2 COMMAS IN A ROW
GO TO 335
132 IF(INS.GE.0)GO TO 36
CC IF(LL.EQ.3)GO TO 433
IF(LL.NE.3.OR.IGEN.GE.0)GO TO 36
C!*** =3 MEANS COMMA FOR P1. (CHECK "IGEN" ABOVE ?)
GO TO 433
13 LL=2
W1=6
CC W2=ENDX+.5
W2=ENDX
C!***** ENDX IS P1+P2 OF THE LONGEST LASTING INST.
IF(JPRNT)WRITE(JTYPE,51)LL,W1,W2
130 J=MM
C!*** WON'T READ LINE BEYOND 'FINISH;' ***************
ENDX=-1
51 FORMAT(I3,35F10.3)
END